library("plotly"); library("readxl"); library("knitr")

CORRRMIN <-
  read_excel(
    "20210521. Datos.xlsx",
    sheet = "BANREP",
    col_types = c("skip", "date", "numeric"),
    
  )
CORRRMIN <- as.matrix(CORRRMIN[complete.cases(CORRRMIN),])
rownames(CORRRMIN) <- (CORRRMIN[, 1])
CORRRMIN <- CORRRMIN[, 2]
MY_TES <- list()
names <- c(1:10)
expiration <- list()
cupón <- c(1:10)
bonds <- list()

for (i in 1:10) {
  MY_TES[[i]] <-
    read_xlsx(
      "20210521. Datos.xlsx",
      sheet = "TES",
      col_types = c("date", "skip", "numeric", "numeric"),
      range = cell_cols((5 * i - 1):(5 * i + 2)),
      na = "#N/A N/A",
      trim_ws = T
    )
  names[i] <- colnames(MY_TES[[i]])[1]
  exp <-
    as.POSIXct(
      stringr::str_extract(names[i], "[0-9]{2}/[0-9]{2}/[0-9]{4}"),
      format = "%m/%d/%Y",
      tz = "UTC"
    )
  expiration[[i]] <- as.Date(exp)
  colnames(MY_TES[[i]]) <- c("Date", "YLD_YTM_MID", "PX_LAST")
  MY_TES[[i]] <- MY_TES[[i]][complete.cases(MY_TES[[i]][, 2:3]),]
  MY_TES[[i]][is.na(MY_TES[[i]])] <-
    as.POSIXct("2010-01-01", tz = Sys.timezone())
  MY_TES[[i]] <- MY_TES[[i]][MY_TES[[i]][["Date"]] <= exp,]
  MY_TES[[i]]$Month <- months(MY_TES[[i]]$Date)
  MY_TES[[i]]$Year <- format(MY_TES[[i]]$Date, format = "%Y")
  
}
cupón <-  as.numeric(stringr::str_extract(names, "([0-9.]+) "))

i<- 7
x<- MY_TES[[i]]$Date
y<- MY_TES[[i]]$PX_LAST
yld <-MY_TES[[i]]$YLD_YTM_MID 
ay <- list(
  tickfont = list(color = "red"),
  overlaying = "y",
  side = "right",
  title = "YLD YTM"
)
f <- list(
  family = "Helvetica, serif",
  color = "#7f7f7f"
)
yaxis <- list(
  title = "Price",
  titlefont = f
)

fig <- plot_ly( x = x, y = y, type = 'scatter', mode = 'lines', name = "Price Bond", )
fig <- fig %>% add_trace(y = ~yld , name = 'Yield YTM', mode = 'lines+markers', yaxis = "y2") 
fig <- fig %>% layout(
    title = names[i], yaxis2 = ay, yaxis = yaxis,
    xaxis = list(title="Fecha"), font = f
  )
fig

obtener_TES <- function(fecha) {
  j <- 0L
  TESES <- 1
  fechas = list()
  pagos = list()
  face_values = 1
  for (i in 1:10) {
    if (fecha %in% MY_TES[[i]]$Date) {
      j <- j + 1L
      years = as.POSIXct(expiration[[i]])
      vencimiento <- as.numeric((years - fecha) / 365)
      if (floor(vencimiento - 1) > 0) {
        fechas[j] <-  list(seq(vencimiento %% 1, vencimiento))
        pagos[j] <-
          list(c(rep(cupón[i], length(fechas[[j]]) - 1), cupón[i] + 100))
        face_values[j] <-
          MY_TES[[i]][MY_TES[[i]]$Date == fecha ,]$PX_LAST
      }
      else{
        pagos[j] <-  cupón[i] + 100
        fechas[j] <- vencimiento
        face_values[j] <-
          MY_TES[[i]][MY_TES[[i]]$Date == fecha ,]$PX_LAST
      }
    }
  }
  list(fechas = fechas,
       pagos = pagos,
       face_values = face_values)
}

calcular_MSE <- function(preciosverdaderos, precioscalculados){
  perdida <- sum((preciosverdaderos-precioscalculados)^2)
  return(perdida)
}

funcion_perdida <- function(curva, pagos, fechas, face_values) {
  precios <- calcular_precios(fechas, pagos, curva)
  perdida <- calcular_MSE(face_values, precios)
  perdida
}

obtener_curva <- function(fecha) {
  datos <- (obtener_TES(fecha = fecha))
  curva_inicial <- c(0.001, 0.0015, 0.005, 0.004, 0.011, 0.009)
  le_optimizacion <- optim(
    curva_inicial,
    funcion_perdida,
    pagos = datos$pagos,
    fechas = datos$fechas,
    face_values =  datos$face_values
  )
  return(list(parametros = le_optimizacion$par, error = le_optimizacion$value))
}

principal = 100
madurez <- 10 # años
fecha_de_emision <-
  as.POSIXct("05/05/2021", format = "%m/%d/%Y", tz = "UTC")
frecuenciaAnual = 2 #Pagos Anuales
cupón_dolares <- 10 # en Dolares
optimizacion <- obtener_curva(fecha_de_emision)
curva_fecha <- optimizacion$parametros
error<- optimizacion$error
### Resultado
precio<- precio_justo(madurez, cupón_dolares, frecuenciaAnual, fecha_de_emision, curva_fecha, principal)
print(paste("El precio justo es de ",precio, ". El error de esimación es de ", error ))

graficar_curva <- function(curva){
  x <- 0:15
  tasa <- curva[1]+ curva[2]*x + curva[3]*(x-1)*(x>1)+
          curva[4]*(x-2)*(x>2)+
          curva[5]*(x-5)*(x>5)+
          curva[6]*(x-10)*(x>10)
  fig <- plot_ly( x = x, y = tasa, name = 'Tasa zero-cupón TES', type = 'scatter', mode = 'lines+markers')  %>% 
          layout(yaxis = list(tickformat = "%"))%>% layout( title = "Curva cero cupón TES (por splines lineales)", xaxis =  list(
  title = "Años (Vencimiento)"
), yaxis = list(
  title = "Tasa cero cupón pesos"
))
  fig
}
graficar_curva(curva_fecha)

obtener_nodos<-function(fecha){
  curva<-obtener_curva(fecha)$parametros
  x<- c(0,1,2,5,10)
  nodos <- curva[1]+ curva[2]*x + curva[3]*(x-1)*(x>1)+
          curva[4]*(x-2)*(x>2)+
          curva[5]*(x-5)*(x>5)+
          curva[6]*(x-10)*(x>10)
  return(nodos)
}
serie_tiempo <- data.frame( Date = MY_TES[[7]]$Date, t(sapply(MY_TES[[7]]$Date, obtener_nodos)))
kable(head(serie_tiempo), digits = 3, caption = "Serie de Tiempo de las curvas cero cupón de Colombia")

serie_tiempo$Month <- months(serie_tiempo$Date)
serie_tiempo$Year <- format(serie_tiempo$Date, format = "%Y")

obtener_componentes<- function(mes, año){
  this_month <-
  serie_tiempo[serie_tiempo$Month == mes &
                 serie_tiempo$Year == año, c("X1", "X2", "X3", "X4", "X5")]
rownames(this_month) <-
  serie_tiempo[serie_tiempo$Month == mes &
                 serie_tiempo$Year == año, c("Date")]

analisis_componentes <-  prcomp(this_month, scale = T, center = F, retx = T)
return(list( x= this_month, comp = analisis_componentes))
}

comp <-obtener_componentes("April", 2021)

analisis_componentes <- comp$comp
this_month <- comp$x

eigen_vectores_princ <-  analisis_componentes$rotation[,1:3]
porcentaje_varianza <- data.frame(Varianza = (analisis_componentes$sdev/ sum(analisis_componentes$sdev))[1:3] )
kable(list(eigen_vectores_princ, porcentaje_varianza)          
      , caption="Loadings de los componentes principales y su % de varianza explicada", booktabs = TRUE, valign = 't')

colnames(eigen_vectores_princ)<-c("PC1","PC2","PC3")
fig <- plot_ly(as.data.frame(eigen_vectores_princ), x =c(0,1,2,5,10) ,y = ~-PC1,type = 'scatter', mode = 'lines+markers', name = "Nivel") 
fig <- fig %>% add_trace(y = ~PC2, name = 'Pendiente',mode = 'lines+markers') 
fig <- fig %>% add_trace(y = ~-PC3, name = 'Curvatura', mode = 'lines+markers') 
fig <- fig %>% layout(title = "Gráfica de Bonos cero cupón contra sus primeros tres componentes (Abril/2021)",
         xaxis = list(title = "Años para madurez"),
         yaxis = list (title = "Puntos Básicos"))
fig